COVID-19 Leader Perceptions Registered Report (Data Checks)

rand_seed = 828
set.seed(rand_seed)

Setup

Package Loading

library(dplyr)

## Warning: replacing previous import 'vctrs::data_frame' by 'tibble::data_frame'
## when loading 'dplyr'

library(tidyr)
library(mgsub)
library(kableExtra)
library(summarytools)
library(qualtRics)
library(ggplot2)
library(psych)
library(ggcorrplot)

Plot Setup

theme_set(theme_test() +
          theme(panel.border = element_blank(),
                plot.title = element_text(hjust = 0.5),
                axis.title = element_text(size = 13, face='bold'),
                axis.title.x = element_text(margin = margin(10, 0, 0, 0)),
                axis.title.y = element_text(margin = margin(0, 10, 0, 0)),
                axis.line = element_line(color='gray20'),
                axis.ticks = element_blank(),
                strip.background = element_blank(),
                strip.text = element_text(face = 'bold', size=12),
                panel.spacing = unit(1, "lines")))

Data Loading

raw_data <- read.csv("raw_data.csv", na.strings = "NOTAVAIL")

First day: 2020-11-26 11:26:50

Last day: 2020-12-22 08:59:25

Exclusions

Exclude unfinished, previews, no consent

Removing 0 previews

Removing 6939 unfinished surveys

Removing 111 < 18 cases

Removing 175 unconsenting cases

raw_data %>%
  filter(# Remove Preview
          Status!="Survey Preview",
          # Completes only
          Finished==TRUE,
          # Consented
          consent_age == "Yes", consent_agree == "Yes") -> data

Remaining subjects 60629

Of these, 24809 completed the study

Check: 24809

Compute duplicates

(Also removes participant IDs from the dataframe)

data %>%
  group_by(IPAddress) %>%
  mutate(countIPtmp = n()) %>%
  group_by(rid) %>%
  mutate(countIDtmp = n()) %>%
  rowwise() %>% 
  mutate(countIP = ifelse(is.na(IPAddress), 1, countIPtmp),
         countID = ifelse(is.na(rid), 1, countIDtmp)) %>%
  ungroup() %>%
  select(-rid) -> data

Exclude attention check fails

Removing 29368 people who failed attention check 1

Of these, 101 completed the study

data <- filter(data, attention_check == "TikTok")

Removing 6644 people who failed attention check 2

Of these, 118 completed the study

data <- filter(data, attention_check2 == "Roses can suffer with pests like aphids and blackfly")

Remaining subjects 24590

Exclusion 1: IP/ID

Removing 518 duplicate IPs

Removing 80 duplicate IDs

(565 unique)

data <- filter(data, countIP == 1, countID == 1)

Exclusion 2: Country

data %>%
  mutate(country=recode(country, "United Arab Emirates" = "UAE",
                        "The Netherlands" = "Netherlands",
                        "Kingdom of Saudi Arabia" = "KSA",
                        "United Kingdom" = "U.K.",
                        "United States" = "U.S.",
                        "South Korea" = "Korea")) %>%
  group_by(surveyName, country) %>%
  summarise(counts= n()) %>%
  ggplot(aes(x=surveyName, y=country, fill=counts)) +
  geom_tile(color='black') +
  theme(axis.text.x = element_text(angle=90))

## `summarise()` regrouping output by 'surveyName' (override with `.groups` argument)

Removing 92 in different country

Removing 4 did not answer

data <- filter(data, (country != "Other" & !is.na(country)))

data %>%
  mutate(country=recode(country, "United Arab Emirates" = "UAE",
                        "The Netherlands" = "Netherlands",
                        "Kingdom of Saudi Arabia" = "KSA",
                        "United Kingdom" = "U.K.",
                        "United States" = "U.S.",
                        "South Korea" = "Korea")) %>%
  group_by(surveyName, country) %>%
  summarise(counts= n()) %>%
  ggplot(aes(x=surveyName, y=country, fill=counts)) +
  geom_tile(color='black') +
  theme(axis.text.x = element_text(angle=90))

## `summarise()` regrouping output by 'surveyName' (override with `.groups` argument)

Exclusion 3: >50% of qs

data %>%
  ungroup() %>%
  select(subId, gender, age, contains("_trust"), OUS1:OUS9, 
         contains("_behav"), contains("_Support"), contains("_Moral"),
         beh_compr, self_comp, starts_with("covid_"),
         country, education, ses2, politics, religious, unicef) %>%
  # 3Moral + 3Support + 4Trust + 1Voting + 2compr = 13
  # 9OUS + 5covid = 14
  # gender + age + education + ses = 4
  # country + politics + religion + unicef = 4
  # sub Id
  # Total: 36
  mutate(count_na = rowSums(is.na(.)),
         respMoreHalfKey = if_else(count_na > 36/2, 1, 0)) %>%
  select(subId, respMoreHalfKey, count_na) %>%
  right_join(data, by='subId') -> data

Removing 0 responded to less than half of key questions

# Moral & Support: 6/10
# Beh: 1/10
# Trust: 4/20
table(data$count_na-(10-6)-(10-1)-(20-4), useNA="always") %>%
  kable()

Var1	Freq
0	15694
1	8059
2	139
3	17
4	7
5	2
6	6
8	1
9	1
11	2
13	1
NA	0

data %>%
  select(subId, count_na) %>%
  mutate(count_na_ok=count_na-(10-6)-(10-1)-(20-4)) %>%
  ggplot(aes(x=count_na_ok)) +
  geom_histogram(binwidth = 1, color='black') +
  xlab("N Unanswered Questions")

data <- filter(data, (respMoreHalfKey == 1 | is.na(respMoreHalfKey)))

Remaining N Post Exclusions: 23929

Rename & Recode variables

data %>%
  mutate(g_age=paste(substr(gender, 1, 1), age_category, sep='_'),
         CompSCheck = if_else(self_comp %in% c("How much I trusted the mayor",
                                               "How much I trusted the official"), "Pass", "Fail"),
         CompSCheck = if_else(is.na(CompSCheck), "Fail", CompSCheck),
         CompBCheck =  if_else(beh_compr == "The leader can transfer the full donation to UNICEF or take some of the money for themselves.", "Pass", "Fail"),
         CompBCheck = if_else(is.na(CompBCheck), "Fail", CompBCheck),
         nPassed = ifelse(CompSCheck == "Pass" & CompBCheck == "Pass", 2, 
                          ifelse(CompSCheck == "Fail" & CompBCheck == "Fail", 0, 1))) %>%
  group_by(surveyName) %>%
  mutate(CountryTotal = n()) -> data

(Of which 3494 failed both comp checks)

data %>% 
  
  rename("argument" = Decision) %>% 
  
  mutate_at(.funs=list(~recode(., 
        "Indifferent" = "4",
        "Strongly support keeping the prolonged restrictions" = "1",
        "Strongly support lifting the restrictions" = "7",
        "Strongly support the tracing devices being voluntary" = "1",
        "Strongly support the tracing devices being mandatory" = "7",
        "Strongly support everyone having equal access to treatment" = "1",
        "Strongly support prioritizing younger and healthier people for treatment" = "7")),
        vars(matches("Support"))) %>%
          
  mutate(M_Support = gsub("Strongly support .*-made medicine being reserved for treating .* citizens", "1", M_Support),
         M_Support = gsub("Strongly support .*-made medicine being given to whoever needs it most", "7", M_Support),
         P_Support = gsub("Strongly support .*-made PPE being reserved for protecting .* citizens", "1", P_Support),
         P_Support = gsub("Strongly support .*-made PPE being given to whoever needs it most", "7", P_Support)) %>%
             
  mutate_at(.funs=list(~recode(., 
        "Absolutely morally wrong" = "1",
        "Neither right nor wrong" = "4",
        "Absolutely morally right" = "7")),
        vars(matches("Moral"))) %>%
 
mutate_at(.funs=list(~recode(., 
        "Not at all trustworthy" = "1",
        "Somewhat trustworthy" = "4",
        "Extremely trustworthy" = "7")),
        vars(matches("trust_1"))) %>%
  
  mutate_at(.funs=list(~recode(., 
        "Not at all likely" = "1",
        "Somewhat likely" = "4",
        "Extremely likely" = "7")),
        vars(matches("trust_2"))) %>%
  
  mutate_at(.funs=list(~as.numeric(.)),
        vars(matches("Support", "Moral", "trust_1", "trust_2"))) %>%
  
  mutate_at(.funs=list(~recode(substr(., 1, 8), 
                              "Person 1" = "Utilitarian", "Person 2" = "Non-Utilitarian")), 
            vars(matches("_CD_"))) %>% 
  mutate_at(.funs=list(~recode(substr(., 1, 8), 
                               "Person 1" = "Non-Utilitarian", "Person 2" = "Utilitarian")), 
            vars(matches("_DC_"))) %>%
  
  # OUS
  mutate_at(.funs=list(~recode(., 
                               "Strongly disagree" = "1", 
                               "Disagree" = "2",
                               "Somewhat disagree" = "3",
                               "Neither agree nor disagree" = "4",
                               "Somewhat agree" = "5",
                               "Agree" = "6",
                               "Strongly agree" = "7")), 
            vars(starts_with("OUS") & !ends_with("DO"))) %>%
  mutate_at(vars(starts_with("OUS") & !ends_with("DO")), as.numeric) %>%
  
  # Rename scenarios
  rename_all(gsub, pattern = '^L_', replacement = 'IH_lockdown_') %>%
  rename_all(gsub, pattern = '^V_', replacement = 'IH_ventilator_') %>%
  rename_all(gsub, pattern = '^T_', replacement = 'IH_tracing_') %>%
  rename_all(gsub, pattern = '^M_', replacement = 'IB_medicine_') %>%
  rename_all(gsub, pattern = '^P_', replacement = 'IB_ppe_') %>% 
  
  # Rename moral arguments
  rename_all(gsub, pattern = '_C_', replacement = '_util_') %>% 
  rename_all(gsub, pattern = '_D_', replacement = '_nonutil_') %>% 

  # Rename dependent variables
  rename_all(gsub, pattern = '_trust_1', replacement = '_trustworthy') %>% 
  rename_all(gsub, pattern = '_trust_2', replacement = '_trustOther') -> data

data$gender_recode <- recode(data$gender,   
                            "Female" = "Female",
                            "Male" = "Male",
                            .default = "Other") # All others listed

data$religious <- recode(data$religious,
                         "Not at all religious" = "1",
                         "Somewhat religious" = "4",
                         "Very religious" = "7")

data$politics <- recode(data$politics,
                         "Left" = "1",
                         "Right" = "7")

data$covid_e_conc <- recode(data$covid_e_conc,
                         "Not at all" = "1",
                         "Very much" = "7")

data$covid_h_c <- recode(data$covid_h_c,
                         "Not at all" = "1",
                         "Very much" = "7")

data$covid_stud <- recode(data$covid_stud,
                         "1-5" = "1",
                         "6-10" = "2",
                         "11-20" = "3",
                         "21-50" = "4",
                         "more than 50" = "5",
                         "I don't remember" = "6")

data$covid_sim <- recode(data$covid_sim,
                         "Not at all similar" = "1",
                         "Slightly similar" = "2",
                         "Moderately similar" = "3",
                         "Very similar" = "4",
                         "Extremely similar" = "5")

data$unicef <- recode(data$unicef,
                         "Not reliable at all" = "1",
                         "Somewhat reliable" = "3",
                         "Very reliable" = "5")

Comprehension Check Failures by Condition

Self-Report Task

data %>%
  mutate(DO_fac = recode(FL_77_DO, 
                         "FL_79" = "Consequentialist",
                         "FL_78" = "Deontological")) %>%
  group_by(surveyName, DO_fac, CompSCheck) %>%
  summarise(counts = n()) %>%
  filter(CompSCheck == "Fail") -> tmp

## `summarise()` regrouping output by 'surveyName', 'DO_fac' (override with `.groups` argument)

min <- min(tmp$counts)
max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=DO_fac, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  xlab("SelfReport Task Condition") +
  ylab("Country") +
  scale_fill_gradient(limits=c(min, max)) + 
  ggtitle("SRep Comp Check Fails by Condition") +
  theme(axis.line.x = element_blank(),
        axis.line.y = element_blank())

Voting Task

data %>%
  filter(CompBCheck == "Fail") %>%
  mutate(DO_fac = recode(FL_266_DO, 
                         "FL_267" = "IH Behavioral",
                         "FL_269" = "IB Behavioral")) %>%
  group_by(surveyName, DO_fac) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName' (override with `.groups` argument)

min <- min(tmp$counts)
max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=DO_fac, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  xlab("Voting Task Condition") +
  ylab("Country") +
  ggtitle("Voting Comp Check Fails by Condition") +
  scale_fill_gradient(limits=c(min, max)) +
  theme(axis.line.x = element_blank(),
        axis.line.y = element_blank())

Other Data Checks

Devices

data %>%
  mutate(`meta_Operating.System` = gsub('[[:digit:]]+|[[:punct:]]| |(CrOS).*|(Linux).*', '', `meta_Operating.System`),
         `meta_Operating.System` = gsub('CPUiPhoneOSlikeMacOSX', 'iPhone', `meta_Operating.System`)) %>%
  {table(.$surveyName, .$`meta_Operating.System`)} %>%
  kable()

		Android	en	Fedora	Gentoo	iPad	iPhone	iPodtouch	Macintosh	U	Ubuntu	WindowsNT	wv	X
Australia	8	390	0	0	0	20	117	2	88	0	2	367	0	0
Brazil	9	611	0	0	0	1	74	0	6	0	1	591	5	0
Canada	21	251	0	0	0	24	165	1	112	1	2	522	2	1
Chile	14	722	0	0	0	5	171	0	43	0	2	511	0	0
China	2	508	1	0	1	6	94	0	6	0	0	898	1	0
Denmark	8	299	0	0	0	60	262	0	134	0	4	388	0	0
France	6	368	0	0	0	6	161	0	39	0	2	491	0	0
Germany	9	354	0	0	0	8	149	0	53	0	11	606	0	2
India	22	853	0	0	0	0	14	0	5	0	3	371	1	0
Israel	5	306	0	0	0	3	66	0	17	0	0	454	0	0
Italy	8	549	0	0	0	7	106	0	32	0	5	424	1	0
Korea	0	459	0	0	0	0	75	0	5	0	0	258	0	0
KSA	13	361	0	0	0	6	110	0	15	0	0	252	0	0
Mexico	4	786	0	0	0	7	124	0	20	0	2	314	3	0
Netherlands	23	419	0	0	0	28	134	0	105	0	2	432	0	0
Norway	3	355	0	0	0	42	320	0	115	0	2	380	0	0
Singapore	0	407	0	0	0	6	126	0	17	0	2	289	1	0
South Africa	17	572	0	0	0	3	78	0	23	0	1	425	0	1
Spain	7	635	0	0	0	11	130	0	40	0	3	426	0	1
U.K.	23	126	0	0	0	15	82	0	120	0	5	492	0	0
U.S.	47	70	0	1	0	3	52	0	120	0	4	589	0	0
UAE	8	250	0	0	0	10	135	0	35	0	0	296	0	0

Languages

data %>%
  group_by(surveyName) %>%
  mutate(TotalCounts= n()) %>%
  group_by(surveyName, UserLanguage, TotalCounts) %>%
  summarise(counts= n()) %>%
  mutate(Perc = counts*100/TotalCounts) %>%
  ggplot(aes(x=surveyName, y=UserLanguage, fill=Perc)) +
  geom_tile(color='black') +
  geom_text(aes(label = round(Perc)), color='white') +
  theme(axis.text.x = element_text(angle=90))

## `summarise()` regrouping output by 'surveyName', 'UserLanguage' (override with `.groups` argument)

Responses distributions

for (dv in c("Support", "Moral", "trustworthy", "trustOther")) {
  data %>% 
    select(surveyName, contains(dv)) %>%
    gather(Q, A, -surveyName) %>%
    separate(Q, into=c("Dimension", "Dilemma", "Q", extra='merge')) %>%
    filter(!is.na(A)) %>%
    group_by(surveyName, Q, A) %>%
    summarise(counts = n()) -> tmp
  max <- max(tmp$counts)
  tmp %>%
    ggplot(aes(x=A, y=surveyName, fill=counts)) +
    geom_tile(color='black') +
    theme(axis.text.x = element_text(angle=90)) +
    scale_fill_gradient(limits=c(0, max)) +
    xlab(dv) +
    ylab("Country") -> p
  print(p)
}

## Warning: Expected 4 pieces. Missing pieces filled with `NA` in 119645 rows [1,
## 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].

## `summarise()` regrouping output by 'surveyName', 'Q' (override with `.groups` argument)

## Warning: Expected 4 pieces. Missing pieces filled with `NA` in 119645 rows [1,
## 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].

## `summarise()` regrouping output by 'surveyName', 'Q' (override with `.groups` argument)

## `summarise()` regrouping output by 'surveyName', 'Q' (override with `.groups` argument)

## `summarise()` regrouping output by 'surveyName', 'Q' (override with `.groups` argument)

Order randomization

for (fac in c("attention_check_DO", "attention_check2_DO",
              "beh_compr_DO", "self_comp_DO", "OUS_DO")) {
  data %>%
    mutate(DO_fac = as.integer(as.factor(get(fac)))) %>%
    group_by(surveyName, DO_fac) %>%
    mutate(counts = n())  -> tmp
  max <- max(tmp$counts)
  tmp %>%
    ggplot(aes(x=DO_fac, y=surveyName, fill=counts)) +
    geom_tile(color='black') +
    theme(axis.text.x = element_text(angle=90)) +
    xlab(gsub("_DO", " Randomization", fac)) +
    scale_fill_gradient(limits=c(0, max)) -> p
  print(p)
}

Condition randomization

data %>%
  select(subId, surveyName, contains(c("_behav", "trustworthy"))) %>% 
  gather(q, a, -subId, -surveyName) %>%
  separate(q, into=c('dimension', 'dilemma', 'task'), sep="_", extra='merge') %>% 
  filter(!is.na(a)) %>%
  group_by(surveyName, dilemma, task) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName', 'dilemma' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=task, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white', size=2.5) +
  theme(axis.text.x = element_text(angle=90)) +
  facet_wrap(~dilemma, nrow=1) +
  scale_fill_gradient(limits=c(0, max))

data %>%
  select(subId, surveyName, contains(c("_Support", "_Moral"))) %>% 
  gather(q, a, -subId, -surveyName) %>%
  separate(q, into=c('dimension', 'dilemma', 'task'), sep="_", extra='merge') %>% 
  filter(!is.na(a)) %>%
  group_by(surveyName, dilemma, task) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName', 'dilemma' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=dilemma, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  theme(axis.text.x = element_text(angle=90)) +
  facet_wrap(~task) +
  scale_fill_gradient(limits=c(0, max))

data %>%
  filter(FL_266_DO == "FL_267") %>%
  mutate(DO_fac = recode(FL_268_DO, 
                         "FL_16" = "Tracing Behav + IB SRep",
                         "FL_105" = "Ventilator Behav + IB SRep",
                         "FL_217" = "Lockdown Behav + IB SRep")) %>%
  group_by(surveyName, DO_fac) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=DO_fac, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  xlab("Dilemma Randomization IH")+
  geom_text(aes(label = counts), color='white') +
  scale_fill_gradient(limits=c(0, max)) +
  theme(axis.text.x = element_text(angle = 45, vjust = .5, hjust=.5))

data %>%
  filter(FL_266_DO == "FL_269") %>%
  mutate(DO_fac = recode(FL_270_DO, 
                         "FL_124" = "PPE Behav + IH SRep",
                         "FL_149" = "Medicine Behav + IH SRep")) %>%
  group_by(surveyName, DO_fac) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=DO_fac, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  xlab("Task Randomization IB")+
  scale_fill_gradient(limits=c(0, max))

data %>%
  select(surveyName, subId, FL_73_DO, FL_106_DO, FL_218_DO, FL_125_DO, FL_150_DO) %>%
  gather(Q, A, -surveyName, -subId) %>%
  drop_na() %>% 
  mutate(Q = recode(Q, "FL_73_DO" = "Tracing B",
                     "FL_106_DO" = "Ventilator B", 
                     "FL_218_DO" = "Lockdown B", 
                     "FL_125_DO" = "PPE B",
                     "FL_150_DO" = "Medicine B"),
         taskOrder = recode(A, "FL_74|FL_75" = "Behav First",
                      "FL_75|FL_74" = "SRep First",
                      "FL_109|FL_107" = "SRep First",
                      "FL_107|FL_109" = "Behav First",
                      "FL_219|FL_225" = "Behav First",
                      "FL_225|FL_219" = "SRep First",
                      "FL_126|FL_128" = "Behav First",
                      "FL_128|FL_126" = "SRep First",
                      "FL_279|FL_151" = "SRep First",
                      "FL_151|FL_279" = "Behav First")) -> tmp

tmp %>%
  select(-Q, -A) %>%
  merge(data) -> data
  
tmp %>%
  group_by(surveyName, Q, taskOrder) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName', 'Q' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=taskOrder, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  xlab("Task Randomization")+
  facet_wrap(~Q, nrow=1) +
  scale_fill_gradient(limits=c(0, max)) +
  theme(axis.text.x = element_text(angle=90))

data %>%
  select(surveyName, subId, FL_73_DO, FL_106_DO, FL_218_DO, FL_125_DO, FL_150_DO) %>%
  gather(Q, A, -surveyName, -subId) %>%
  drop_na() %>% 
  mutate(Q = recode(Q, "FL_73_DO" = "Tracing B",
                     "FL_106_DO" = "Ventilator B", 
                     "FL_218_DO" = "Lockdown B", 
                     "FL_125_DO" = "PPE B",
                     "FL_150_DO" = "Medicine B"),
         taskOrder = recode(A, "FL_74|FL_75" = "Behav First",
                      "FL_75|FL_74" = "SRep First",
                      "FL_109|FL_107" = "SRep First",
                      "FL_107|FL_109" = "Behav First",
                      "FL_219|FL_225" = "Behav First",
                      "FL_225|FL_219" = "SRep First",
                      "FL_126|FL_128" = "Behav First",
                      "FL_128|FL_126" = "SRep First",
                      "FL_279|FL_151" = "SRep First",
                      "FL_151|FL_279" = "Behav First")) -> tmp

tmp %>%
  select(-Q, -A) %>%
  merge(data) -> data
  
data %>%
  group_by(surveyName, taskOrder) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=taskOrder, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  xlab("Task Randomization")+
  scale_fill_gradient(limits=c(0, max)) 

data %>%
  select(surveyName, FL_171_DO, FL_180_DO, FL_221_DO, FL_183_DO, FL_187_DO) %>%
  gather(Q, A, -surveyName) %>%
  drop_na() %>% 
  separate(A, c("Dilemma", "Randomization"), sep="BehaviouralTask") %>%
  mutate(Randomization=gsub("[()]", "", Randomization)) %>%
  group_by(surveyName, Dilemma, Randomization) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName', 'Dilemma' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=Randomization, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  xlab("Behavioral Task Randomization")+
  facet_wrap(~Dilemma, nrow=1) +
  scale_fill_gradient(limits=c(0, max)) +
  theme(axis.text.x = element_text(angle=90))

data %>%
  select(surveyName, FL_76_DO, FL_110_DO, FL_226_DO, FL_129_DO, FL_280_DO) %>%
  gather(Q, A, -surveyName) %>%
  drop_na() %>% 
  mutate(Q = recode(Q, "FL_76_DO" = "Tracing B",
                     "FL_110_DO" = "Ventilator B", 
                     "FL_226_DO" = "Lockdown B", 
                     "FL_129_DO" = "Medicine B",
                     "FL_280_DO" = "PPE B"),
         A = recode(A,"FL_68|FL_24" = "Medicine+PPE",
                      "FL_24|FL_68" = "PPE+Medicine", 
                      "FL_111|FL_117" = "Medicine+PPE",
                      "FL_117|FL_111" = "PPE+Medicine", 
                      "FL_233|FL_227" = "Medicine+PPE",
                      "FL_227|FL_233" = "PPE+Medicine", 
                      "FL_250|FL_136" = "Lockdown+Ventilator",
                      "FL_136|FL_250" = "Ventilator+Lockdown",
                      "FL_130|FL_136" = "Tracing+Ventilator",
                      "FL_136|FL_130" = "Ventilator+Tracing",
                      "FL_250|FL_130" = "Lockdown+Tracing",
                      "FL_130|FL_250" = "Tracing+Lockdown",
                      "FL_287|FL_293" = "Lockdown+Ventilator",
                      "FL_293|FL_287" = "Ventilator+Lockdown",
                      "FL_281|FL_293" = "Tracing+Ventilator",
                      "FL_293|FL_281" = "Ventilator+Tracing",
                      "FL_281|FL_287" = "Tracing+Lockdown",
                      "FL_287|FL_281" = "Lockdown+Tracing")) %>%
  group_by(surveyName, Q, A) %>%
  summarise(counts = n()) -> tmp

## `summarise()` regrouping output by 'surveyName', 'Q' (override with `.groups` argument)

max <- max(tmp$counts)
tmp %>%
  ggplot(aes(x=A, y=surveyName, fill=counts)) +
  geom_tile(color='black') +
  geom_text(aes(label = counts), color='white') +
  xlab("Self Report Task")+
  facet_wrap(~Q, nrow=1, scales = "free_x") +
  scale_fill_gradient(limits=c(0, max)) +
  theme(axis.text.x = element_text(angle=90))

Demographic variables

# Gender
data %>%
  ggplot(aes(x=gender_recode, fill=gender_recode)) +
  geom_histogram(stat='count') +
  facet_wrap(~surveyName) +
  xlab("Gender") +
  theme(axis.text.x = element_blank())

## Warning: Ignoring unknown parameters: binwidth, bins, pad

edu_info <- read.csv('education_recoding.txt', sep='\t')
edu_info <- mutate(edu_info, education = gsub("’", "'", education))
data <- mutate(data, education = gsub("’", "'", education))
data <- left_join(data, edu_info, by=c("surveyName", "education"))

for (dv in c("education_recode", "ses2", "religious", "politics")) {
  titleDic <- c("education_recode"='Education', 
                "ses2"='SocioEconomic Status',
                "religious"="Religiosity",
                "politics"="Politics")
  data %>% 
    ggplot(aes(x=as.numeric(get(dv)))) +
    geom_histogram(binwidth = 1) +
    facet_wrap(~surveyName) +
    xlab(titleDic[dv]) -> p
  print(p)
}

## Warning: Removed 6 rows containing non-finite values (stat_bin).

## Warning: Removed 58 rows containing non-finite values (stat_bin).

## Warning: Removed 9 rows containing non-finite values (stat_bin).

## Warning: Removed 40 rows containing non-finite values (stat_bin).

Other Variables

for (dv in c("covid_e_conc", "covid_h_c", "covid_stud", "covid_sim", "unicef")) {
  titleDic <- c("covid_e_conc"="Covid Concerns, Economic",
                "covid_h_c"="Covid Concerns, Health",
                "covid_stud"="N Covid Studies",
                "covid_sim"="Similarity Covid Studies",
                "unicef"="UNICEF Reliability")
  data %>% 
    ggplot(aes(x=as.numeric(get(dv)))) +
    geom_histogram(binwidth = 1) +
    facet_wrap(~surveyName) +
    xlab(titleDic[dv]) -> p
  print(p)
}

## Warning: Removed 3 rows containing non-finite values (stat_bin).

## Warning: Removed 1 rows containing non-finite values (stat_bin).

## Warning: Removed 2 rows containing non-finite values (stat_bin).

## Warning: Removed 8051 rows containing non-finite values (stat_bin).

## Warning: Removed 19 rows containing non-finite values (stat_bin).

OUS

data %>% 
  rowwise() %>%
  mutate(avg_OUS_IB=mean(c(OUS1, OUS2, OUS3, OUS4, OUS5), na.rm=T),
         avg_OUS_IH=mean(c(OUS6, OUS7, OUS8, OUS9), na.rm=T),
         sd_OUS=round(sd(c(OUS1, OUS2, OUS3, OUS4, OUS5, OUS6, OUS7, OUS8, OUS9)), 2)) -> data

kable(head(select(data, subId, contains("OUS"), -religious, -OUS_DO)))

subId	OUS1	OUS2	OUS3	OUS4	OUS5	OUS6	OUS7	OUS8	OUS9	avg_OUS_IB	avg_OUS_IH	sd_OUS
58508	4	2	4	6	5	1	1	1	2	4.2	1.25	1.90
58510	3	5	3	5	5	4	5	2	3	4.2	3.50	1.17
58512	1	2	2	1	2	5	5	5	5	1.6	5.00	1.83
58517	4	6	6	6	7	4	4	4	5	5.8	4.25	1.17
58519	3	4	3	5	5	4	3	5	4	4.0	4.00	0.87
58520	6	6	6	6	6	3	2	4	4	6.0	3.25	1.56

data %>%
  ungroup() %>%
  select(OUS1:OUS9) %>%
  cor(use = "complete.obs") %>%
  ggcorrplot(outline.col = "black", lab=T) +
  geom_hline(yintercept = 5.5) +
  geom_vline(xintercept = 5.5)

data %>%
  ungroup() %>%
  select(OUS1:OUS5) %>%
  drop_na() %>%
  psych::alpha() -> IB_alpha

data %>%
  ungroup() %>%
  select(OUS6:OUS9) %>%
  drop_na() %>%
  psych::alpha() -> IH_alpha

IB reliability: 0.72

IH reliability: 0.72

Save data

Wide Format

data <- rename(data, 'subj_SES'="ses2", "education_text"="education",
               "education"="education_recode",
               "religiosity"="religious", "pol_ideology"="politics")

data <- mutate(data, check_selfrep = recode(CompSCheck, "Pass" = 1, "Fail" = 0),
               check_voting = recode(CompBCheck, "Pass" = 1, "Fail" = 0),
               argument = recode(argument, "Consequentialist" = "Utilitarian", 
                             "Deontological" = "Non-Utilitarian"))

write.csv(data, "data_complete.csv", row.names = F)

data %>%
  select(subId, check_selfrep, check_voting, argument, taskOrder,
         gender_recode, age, education, subj_SES, pol_ideology, religiosity, country, 
         contains("_behav"), contains("_trustOther"), contains("_trustworthy"), 
         contains("_Moral"), contains("_Support")) -> data

write.csv(data, "data_wideFormat.csv", row.names = F)

knitr::opts_chunk$set(results = "asis")
data %>% 
  select(-subId) %>%
  dfSummary(na.col=F) %>%
  print(max.tbl.height = 500,
      method = "render")

Data Frame Summary

Dimensions: 23929 x 51
Duplicates: 1

No	Variable	Stats / Values	Freqs (% of Valid)	Graph	Valid
1	check_selfrep [numeric]	Min : 0 Mean : 0.7 Max : 1	0 : 6228 ( 26.0% ) 1 : 17701 ( 74.0% )		23929 (100%)
2	check_voting [numeric]	Min : 0 Mean : 0.5 Max : 1	0 : 11210 ( 46.9% ) 1 : 12719 ( 53.1% )		23929 (100%)
3	argument [character]	1. Non-Utilitarian 2. Utilitarian	11857 ( 49.5% ) 12072 ( 50.4% )		23929 (100%)
4	taskOrder [character]	1. Behav First 2. SRep First	11948 ( 49.9% ) 11981 ( 50.1% )		23929 (100%)
5	gender_recode [character]	1. Female 2. Male 3. Other	11988 ( 50.1% ) 11720 ( 49.0% ) 220 ( 0.9% )		23928 (100%)
6	age [integer]	Mean (sd) : 43.7 (16.5) min < med < max: 18 < 41 < 98 IQR (CV) : 27 (0.4)	76 distinct values		23835 (99.61%)
7	education [integer]	Mean (sd) : 5.4 (1.4) min < med < max: 1 < 6 < 8 IQR (CV) : 2 (0.3)	1 : 72 ( 0.3% ) 2 : 451 ( 1.9% ) 3 : 1328 ( 5.5% ) 4 : 5063 ( 21.2% ) 5 : 4247 ( 17.8% ) 6 : 9138 ( 38.2% ) 7 : 1674 ( 7.0% ) 8 : 1950 ( 8.2% )		23923 (99.97%)
8	subj_SES [integer]	Mean (sd) : 5.6 (1.7) min < med < max: 1 < 6 < 10 IQR (CV) : 3 (0.3)	1 : 240 ( 1.0% ) 2 : 627 ( 2.6% ) 3 : 1930 ( 8.1% ) 4 : 3210 ( 13.5% ) 5 : 5278 ( 22.1% ) 6 : 5258 ( 22.0% ) 7 : 4573 ( 19.2% ) 8 : 2061 ( 8.6% ) 9 : 396 ( 1.7% ) 10 : 298 ( 1.2% )		23871 (99.76%)
9	pol_ideology [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	2439 ( 10.2% ) 2104 ( 8.8% ) 3283 ( 13.7% ) 8915 ( 37.3% ) 3117 ( 13.1% ) 1512 ( 6.3% ) 2519 ( 10.5% )		23889 (99.83%)
10	religiosity [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	7357 ( 30.8% ) 2298 ( 9.6% ) 1843 ( 7.7% ) 5710 ( 23.9% ) 2232 ( 9.3% ) 2089 ( 8.7% ) 2391 ( 10.0% )		23920 (99.96%)
11	country [character]	1. China 2. Chile 3. Brazil 4. India 5. Mexico 6. Spain 7. Norway 8. Germany 9. Denmark 10. The Netherlands [ 12 others ]	1517 ( 6.3% ) 1468 ( 6.1% ) 1298 ( 5.4% ) 1269 ( 5.3% ) 1260 ( 5.3% ) 1253 ( 5.2% ) 1217 ( 5.1% ) 1192 ( 5.0% ) 1155 ( 4.8% ) 1143 ( 4.8% ) 11157 ( 46.6% )		23929 (100%)
12	IH_tracing_CD_behav [character]	1. Non-Utilitarian 2. Utilitarian	1174 ( 59.0% ) 817 ( 41.0% )		1991 (8.32%)
13	IH_tracing_DC_behav [character]	1. Non-Utilitarian 2. Utilitarian	1319 ( 66.1% ) 677 ( 33.9% )		1996 (8.34%)
14	IH_ventilator_DC_behav [character]	1. Non-Utilitarian 2. Utilitarian	1763 ( 87.3% ) 257 ( 12.7% )		2020 (8.44%)
15	IH_ventilator_CD_behav [character]	1. Non-Utilitarian 2. Utilitarian	1637 ( 82.2% ) 355 ( 17.8% )		1992 (8.32%)
16	IH_lockdown_DC_behav [character]	1. Non-Utilitarian 2. Utilitarian	1447 ( 73.3% ) 528 ( 26.7% )		1975 (8.25%)
17	IH_lockdown_CD_behav [character]	1. Non-Utilitarian 2. Utilitarian	1339 ( 66.7% ) 668 ( 33.3% )		2007 (8.39%)
18	IB_ppe_DC_behav [character]	1. Non-Utilitarian 2. Utilitarian	1436 ( 48.1% ) 1551 ( 51.9% )		2987 (12.48%)
19	IB_ppe_CD_behav [character]	1. Non-Utilitarian 2. Utilitarian	1168 ( 39.7% ) 1774 ( 60.3% )		2942 (12.29%)
20	IB_medicine_DC_behav [character]	1. Non-Utilitarian 2. Utilitarian	1270 ( 42.6% ) 1711 ( 57.4% )		2981 (12.46%)
21	IB_medicine_CD_behav [character]	1. Non-Utilitarian 2. Utilitarian	1109 ( 36.8% ) 1905 ( 63.2% )		3014 (12.6%)
22	IB_medicine_nonutil_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	765 ( 12.8% ) 483 ( 8.1% ) 792 ( 13.2% ) 2021 ( 33.8% ) 759 ( 12.7% ) 554 ( 9.3% ) 611 ( 10.2% )		5985 (25.01%)
23	IB_medicine_util_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	501 ( 8.3% ) 269 ( 4.5% ) 537 ( 8.9% ) 1933 ( 32.2% ) 973 ( 16.2% ) 860 ( 14.3% ) 929 ( 15.5% )		6002 (25.08%)
24	IB_ppe_nonutil_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	609 ( 10.2% ) 424 ( 7.1% ) 737 ( 12.3% ) 2099 ( 35.1% ) 839 ( 14.0% ) 636 ( 10.6% ) 640 ( 10.7% )		5984 (25.01%)
25	IB_ppe_util_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	487 ( 8.1% ) 267 ( 4.5% ) 543 ( 9.0% ) 1935 ( 32.2% ) 1006 ( 16.8% ) 886 ( 14.8% ) 879 ( 14.6% )		6003 (25.09%)
26	IH_tracing_nonutil_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	305 ( 7.9% ) 190 ( 4.9% ) 369 ( 9.5% ) 1340 ( 34.7% ) 595 ( 15.4% ) 514 ( 13.3% ) 553 ( 14.3% )		3866 (16.16%)
27	IH_tracing_util_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	873 ( 21.7% ) 370 ( 9.2% ) 477 ( 11.9% ) 1158 ( 28.8% ) 420 ( 10.4% ) 361 ( 9.0% ) 361 ( 9.0% )		4020 (16.8%)
28	IH_lockdown_nonutil_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	200 ( 5.2% ) 122 ( 3.1% ) 267 ( 6.9% ) 1213 ( 31.3% ) 696 ( 17.9% ) 702 ( 18.1% ) 678 ( 17.5% )		3878 (16.21%)
29	IH_lockdown_util_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	744 ( 18.7% ) 427 ( 10.7% ) 547 ( 13.7% ) 1165 ( 29.2% ) 476 ( 11.9% ) 311 ( 7.8% ) 315 ( 7.9% )		3985 (16.65%)
30	IH_ventilator_nonutil_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	95 ( 2.4% ) 72 ( 1.8% ) 183 ( 4.6% ) 1100 ( 27.5% ) 655 ( 16.4% ) 882 ( 22.1% ) 1011 ( 25.3% )		3998 (16.71%)
31	IH_ventilator_util_trustOther [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	1214 ( 29.4% ) 554 ( 13.4% ) 526 ( 12.7% ) 1087 ( 26.3% ) 348 ( 8.4% ) 227 ( 5.5% ) 175 ( 4.2% )		4131 (17.26%)
32	IB_medicine_nonutil_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	686 ( 11.5% ) 460 ( 7.7% ) 718 ( 12.0% ) 1819 ( 30.4% ) 769 ( 12.8% ) 660 ( 11.0% ) 873 ( 14.6% )		5985 (25.01%)
33	IB_medicine_util_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	449 ( 7.5% ) 268 ( 4.5% ) 393 ( 6.6% ) 1680 ( 28.0% ) 929 ( 15.5% ) 985 ( 16.4% ) 1298 ( 21.6% )		6002 (25.08%)
34	IB_ppe_nonutil_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	543 ( 9.1% ) 390 ( 6.5% ) 604 ( 10.1% ) 1841 ( 30.8% ) 837 ( 14.0% ) 778 ( 13.0% ) 991 ( 16.6% )		5984 (25.01%)
35	IB_ppe_util_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	471 ( 7.8% ) 249 ( 4.2% ) 435 ( 7.2% ) 1682 ( 28.0% ) 944 ( 15.7% ) 976 ( 16.3% ) 1246 ( 20.8% )		6003 (25.09%)
36	IH_tracing_nonutil_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	314 ( 8.1% ) 208 ( 5.4% ) 297 ( 7.7% ) 1085 ( 28.1% ) 534 ( 13.8% ) 603 ( 15.6% ) 825 ( 21.3% )		3866 (16.16%)
37	IH_tracing_util_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	934 ( 23.2% ) 367 ( 9.1% ) 394 ( 9.8% ) 1011 ( 25.1% ) 447 ( 11.1% ) 358 ( 8.9% ) 509 ( 12.7% )		4020 (16.8%)
38	IH_lockdown_nonutil_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	178 ( 4.6% ) 115 ( 3.0% ) 221 ( 5.7% ) 980 ( 25.3% ) 603 ( 15.6% ) 790 ( 20.4% ) 991 ( 25.6% )		3878 (16.21%)
39	IH_lockdown_util_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	741 ( 18.6% ) 431 ( 10.8% ) 469 ( 11.8% ) 1101 ( 27.6% ) 489 ( 12.3% ) 341 ( 8.6% ) 413 ( 10.4% )		3985 (16.65%)
40	IH_ventilator_nonutil_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	84 ( 2.1% ) 72 ( 1.8% ) 125 ( 3.1% ) 719 ( 18.0% ) 476 ( 11.9% ) 915 ( 22.9% ) 1607 ( 40.2% )		3998 (16.71%)
41	IH_ventilator_util_trustworthy [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	1252 ( 30.3% ) 517 ( 12.5% ) 506 ( 12.2% ) 1019 ( 24.7% ) 388 ( 9.4% ) 221 ( 5.3% ) 227 ( 5.5% )		4130 (17.26%)
42	IH_tracing_Moral [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	3887 ( 32.7% ) 1191 ( 10.0% ) 1236 ( 10.4% ) 2239 ( 18.9% ) 977 ( 8.2% ) 806 ( 6.8% ) 1539 ( 13.0% )		11875 (49.63%)
43	IB_medicine_Moral [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	1101 ( 6.1% ) 603 ( 3.4% ) 1055 ( 5.9% ) 4475 ( 24.9% ) 2550 ( 14.2% ) 2532 ( 14.1% ) 5670 ( 31.5% )		17986 (75.16%)
44	IB_ppe_Moral [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	1104 ( 6.2% ) 601 ( 3.4% ) 1033 ( 5.8% ) 4677 ( 26.1% ) 2774 ( 15.5% ) 2510 ( 14.0% ) 5230 ( 29.2% )		17929 (74.93%)
45	IH_ventilator_Moral [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	4652 ( 38.3% ) 1613 ( 13.3% ) 1476 ( 12.2% ) 2545 ( 21.0% ) 781 ( 6.4% ) 445 ( 3.7% ) 631 ( 5.2% )		12143 (50.75%)
46	IH_lockdown_Moral [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	2423 ( 20.4% ) 1416 ( 11.9% ) 1637 ( 13.8% ) 3008 ( 25.4% ) 1295 ( 10.9% ) 774 ( 6.5% ) 1294 ( 10.9% )		11847 (49.51%)
47	IH_tracing_Support [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	5063 ( 42.6% ) 1072 ( 9.0% ) 839 ( 7.1% ) 957 ( 8.1% ) 927 ( 7.8% ) 1014 ( 8.5% ) 1999 ( 16.8% )		11871 (49.61%)
48	IB_medicine_Support [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	4540 ( 25.2% ) 1889 ( 10.5% ) 1863 ( 10.4% ) 1529 ( 8.5% ) 1742 ( 9.7% ) 1713 ( 9.5% ) 4711 ( 26.2% )		17987 (75.17%)
49	IB_ppe_Support [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	4738 ( 26.4% ) 1883 ( 10.5% ) 1973 ( 11.0% ) 1609 ( 9.0% ) 1877 ( 10.5% ) 1644 ( 9.2% ) 4200 ( 23.4% )		17924 (74.9%)
50	IH_ventilator_Support [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	7019 ( 57.8% ) 1395 ( 11.5% ) 969 ( 8.0% ) 704 ( 5.8% ) 804 ( 6.6% ) 539 ( 4.4% ) 711 ( 5.9% )		12141 (50.74%)
51	IH_lockdown_Support [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	3504 ( 29.6% ) 1871 ( 15.8% ) 1722 ( 14.5% ) 932 ( 7.9% ) 1369 ( 11.6% ) 960 ( 8.1% ) 1489 ( 12.6% )		11847 (49.51%)

Generated by summarytools 0.9.6 (R version 4.0.2)
2021-04-07

Long Format

data %>% 
  gather(measure, answer, -c(subId:country)) %>%
  separate(measure, c('dimension', "dilemma", "measure"), "_", 
           extra = "merge", fill="left") %>%
  separate(measure, c('extra', 'measure'), "_", fill="left") %>%
  select(-extra) %>%
  filter(!is.na(answer)) %>%
  spread(measure, answer) %>%
  rename("support"="Support") -> data_long

Add the Composite Measure of trust

data_long %>%
  mutate(trustworthy = as.numeric(trustworthy), 
         trustOther = as.numeric(trustOther)) %>%
  rowwise() %>% 
  mutate(avg_trust = mean(c(trustworthy, trustOther))) -> data_long
kable(head(arrange(select(data_long, dimension:avg_trust), trustOther)))

dimension	dilemma	behav	Moral	support	trustOther	trustworthy	avg_trust
IB	medicine	NA	7	4	1	1	1.0
IB	medicine	NA	7	6	1	2	1.5
IB	medicine	NA	7	7	1	1	1.0
IB	medicine	NA	7	7	1	1	1.0
IB	medicine	NA	7	7	1	4	2.5
IB	medicine	NA	7	7	1	7	4.0

write.csv(data_long, file = "data.csv", row.names=FALSE)

knitr::opts_chunk$set(results = "asis")
data_long %>% 
  select(-subId) %>%
  dfSummary(na.col=F) %>%
  print(max.tbl.height = 500,
      method = "render")

Data Frame Summary

data_long

Dimensions: 71786 x 19
Duplicates: 19

No	Variable	Stats / Values	Freqs (% of Valid)	Graph	Valid
1	check_selfrep [numeric]	Min : 0 Mean : 0.7 Max : 1	0 : 18683 ( 26.0% ) 1 : 53103 ( 74.0% )		71786 (100%)
2	check_voting [numeric]	Min : 0 Mean : 0.5 Max : 1	0 : 33629 ( 46.9% ) 1 : 38157 ( 53.1% )		71786 (100%)
3	argument [character]	1. Non-Utilitarian 2. Utilitarian	35570 ( 49.5% ) 36216 ( 50.4% )		71786 (100%)
4	taskOrder [character]	1. Behav First 2. SRep First	35844 ( 49.9% ) 35942 ( 50.1% )		71786 (100%)
5	gender_recode [character]	1. Female 2. Male 3. Other	35963 ( 50.1% ) 35160 ( 49.0% ) 660 ( 0.9% )		71783 (100%)
6	age [integer]	Mean (sd) : 43.7 (16.5) min < med < max: 18 < 41 < 98 IQR (CV) : 27 (0.4)	76 distinct values		71504 (99.61%)
7	education [integer]	Mean (sd) : 5.4 (1.4) min < med < max: 1 < 6 < 8 IQR (CV) : 2 (0.3)	1 : 216 ( 0.3% ) 2 : 1353 ( 1.9% ) 3 : 3984 ( 5.5% ) 4 : 15189 ( 21.2% ) 5 : 12741 ( 17.8% ) 6 : 27413 ( 38.2% ) 7 : 5022 ( 7.0% ) 8 : 5850 ( 8.2% )		71768 (99.97%)
8	subj_SES [integer]	Mean (sd) : 5.6 (1.7) min < med < max: 1 < 6 < 10 IQR (CV) : 3 (0.3)	1 : 720 ( 1.0% ) 2 : 1881 ( 2.6% ) 3 : 5790 ( 8.1% ) 4 : 9630 ( 13.5% ) 5 : 15834 ( 22.1% ) 6 : 15774 ( 22.0% ) 7 : 13719 ( 19.2% ) 8 : 6183 ( 8.6% ) 9 : 1188 ( 1.7% ) 10 : 894 ( 1.2% )		71613 (99.76%)
9	pol_ideology [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	7317 ( 10.2% ) 6312 ( 8.8% ) 9849 ( 13.7% ) 26745 ( 37.3% ) 9351 ( 13.1% ) 4536 ( 6.3% ) 7557 ( 10.5% )		71667 (99.83%)
10	religiosity [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	22071 ( 30.8% ) 6894 ( 9.6% ) 5529 ( 7.7% ) 17130 ( 23.9% ) 6696 ( 9.3% ) 6267 ( 8.7% ) 7173 ( 10.0% )		71760 (99.96%)
11	country [character]	1. China 2. Chile 3. Brazil 4. India 5. Mexico 6. Spain 7. Norway 8. Germany 9. Denmark 10. The Netherlands [ 12 others ]	4551 ( 6.3% ) 4404 ( 6.1% ) 3894 ( 5.4% ) 3807 ( 5.3% ) 3780 ( 5.3% ) 3759 ( 5.2% ) 3651 ( 5.1% ) 3576 ( 5.0% ) 3465 ( 4.8% ) 3429 ( 4.8% ) 33470 ( 46.6% )		71786 (100%)
12	dimension [character]	1. IB 2. IH	35917 ( 50.0% ) 35869 ( 50.0% )		71786 (100%)
13	dilemma [character]	1. lockdown 2. medicine 3. ppe 4. tracing 5. ventilator	11849 ( 16.5% ) 17988 ( 25.1% ) 17929 ( 25.0% ) 11877 ( 16.6% ) 12143 ( 16.9% )		71786 (100%)
14	behav [character]	1. Non-Utilitarian 2. Utilitarian	13662 ( 57.1% ) 10243 ( 42.9% )		23905 (33.3%)
15	Moral [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	13167 ( 18.3% ) 5424 ( 7.6% ) 6437 ( 9.0% ) 16944 ( 23.6% ) 8377 ( 11.7% ) 7067 ( 9.8% ) 14364 ( 20.0% )		71780 (99.99%)
16	support [character]	1. 1 2. 2 3. 3 4. 4 5. 5 6. 6 7. 7	24864 ( 34.6% ) 8110 ( 11.3% ) 7366 ( 10.3% ) 5731 ( 8.0% ) 6719 ( 9.4% ) 5870 ( 8.2% ) 13110 ( 18.3% )		71770 (99.98%)
17	trustOther [numeric]	Mean (sd) : 4.2 (1.8) min < med < max: 1 < 4 < 7 IQR (CV) : 3 (0.4)	1 : 5793 ( 12.1% ) 2 : 3178 ( 6.6% ) 3 : 4978 ( 10.4% ) 4 : 15051 ( 31.4% ) 5 : 6767 ( 14.1% ) 6 : 5933 ( 12.4% ) 7 : 6152 ( 12.9% )		47852 (66.66%)
18	trustworthy [numeric]	Mean (sd) : 4.4 (1.9) min < med < max: 1 < 4 < 7 IQR (CV) : 3 (0.4)	1 : 5652 ( 11.8% ) 2 : 3077 ( 6.4% ) 3 : 4162 ( 8.7% ) 4 : 12937 ( 27.0% ) 5 : 6416 ( 13.4% ) 6 : 6627 ( 13.9% ) 7 : 8980 ( 18.8% )		47851 (66.66%)
19	avg_trust [numeric]	Mean (sd) : 4.3 (1.8) min < med < max: 1 < 4 < 7 IQR (CV) : 2.5 (0.4)	13 distinct values		47849 (66.66%)

Generated by summarytools 0.9.6 (R version 4.0.2)
2021-04-07